Wonky Flux Batch 2019 02

home *** CD-ROM | disk | FTP | other *** search

/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 090 - CAD Draw.dsk / T.APSOFT I.s < prev next >

Wrap

Text File | 2019-02-17 | 42KB | 1,681 lines

PAG ***************************** * T * * Applesof;PGPPart I * * {{{ * * Copywrite Apple Computer, * * Inc. and Microsoft, Inc.; * * not for publication or * * distribution. * * * ***************************** * * * Input parsing, * * Routine addressing, * * For-next loops, etc. * * * * $D000 - $DD66 * * * ***************************** * Equates for all parts: * Applesoft tokens: for = $81 data = $83 pop = $A1 goto = $AB gosub = $B0 rem = $B2 print = $BA tab = $C0 to = $C1 fn = $C2 spc = $C3 then = $C4 at = $C5 not = $C6 step = $C7 plus = $C8 minus = $C9 equal = $D0 sgn = $D2 scrn = $D7 leftstr = $E8 * Zero page locations: GOWARM = 0 ;Set up by cold start GOSTROUT = 3 ; but not used anywhere. USR = $A CHARAC = $D ENDCHR = $E PNTR = $F NUMDIM = $F ;Used in array rtns DIMFLG = $10 VALTYP = $11 ;$FF for string, 0 if numeric INTFLG = $12 ;- for int var DATAFLG = $13 ;Used in PARSE GARFLG = DATAFLG ;Used in GARBAG SUBFLG = $14 INPUTFLG = $15 ;Has $40 for GET, $98 for READ CPRMASK = $16 ;Receives CPRTYP in FRMEVL SIGNFLG = $16 ;Flags sign in TAN SHAPEL = $1A SHAPEH = $1B HCOLOR1 = $1C COUNTH = $1D CH = $24 GBASL = $26 GBASH = $27 H2 = $2C V2 = $2D HMASK = $30 INVFLZg $32 PROMPT = $33 A1L = $3C A1H = $3D A2L = $3E A2H = $3[8INNUM = $50 TEMPPT ~52 LASTPT = $53 TEMPST = $55 INDEX = $5EqST = $60 RESULT = $62 TXTTAB = 9um VARTAB = $69 ARYTAB = $6B STREND = $6D FRETOP = $6F FRESPC = $71 MEMSIZ = $73 CURLIN = $75 OLDLIN = $77 OLDTEXT = $79 DATLIN = $7B DATPTR = $7D INPTR = $7F VARNAM = $81 ;$:+-, %:--, real:++, fnc:-+ VARPNT = $83 FORPNT = $85 TXPSV = $87WUsed in IK)D LASTOP = $87 ;Scratch flag used in FRMEVL CPRTYP = $89 ;>,=,< flag in FRMEVL FNCNAM = $8A DSCPTR = $8C DSCLEN = $8F ;Used in GARBAG JMPADRS = $90 LENGTH = $91 ;Used in GARBAG ARYPNT = $94 ;Used in GARBAG HIGHDS = $94 HIGHTR = $96 INDX = $99 ;Used by array rtns LOWTR = $9B DSCTMP = $9D VPNT = $A0 ;Temp var ptr EXTRASV = $92 ;FP extra precision TEMP1 = $93 ;Save areas for FAC TEMP2 = $98 TEMP3 = $8A TMPEXP = $99 ;Used in%bd;Vg`cx]3^'O=%b$$P|;XibE88pG%//{dNf)D{jCL5w,[NZiJ_97%on QM*baj_xVn~Bv. FAC = $9D ;Primary floating pnt acc SERLEN = $A3 ;Holds length of series-1 FPGEN = $A4 ARG = $A5 ;Secondary fp acc FACSGN = FAC+5 ;Holds unpacked sign ARGSGN = ARG+5 SGNCPR = $AB ;Flags opp sign in FP rout. EXTRAFAC = $AC ;FP precision SERPNT = $AD ;Pntr to series data in FP STRNG1 = $AB STRNG2 = $AD PRGEND = $AF CHRGET = $B1 CHRGOT = $B7 TXTPTR = $B8 RNDSEED = $C9 DXL = $D0 DXH = $D1 DY = $D2 QDRNT = $D3 EL = $D4 EH = $D5 LOCK = $D6 ;Prevents user accevs if#- ERRFLG = $D8 ERRLIN = $DA ERRPOVY,={f"}z9(-Dwu<<;BE$$DF r = $E0 X0H = $E1 Y0 = $E2 HCOLORZ = $E4 HNDX = $E5 HPAG = $E6 SCALEZ = $E7 SHAPEPNT = $E8 COLCOUNT = $EA FIRST = $F0 SPEEDZ = $F1 ;Output speed TRCFLG = $F2 ORMASK = $F3 ;Has $40 for flash TXTPSV = $F4 CURLSV = $F6 REMSTK = $F8 ROTZ = $F9 * $FF is also used by the string out rtns. * Apple stuff: STACK = $100 IN = $200 AMPER = $3F5 KEY = $C000 TXTCLR = $C050 MIXCLR = $C052 MIXSET = $C053 LOWSCR = $C054 HISCR = $C055 LORES = $C056 HIRES = $C057 HOME = $FC58 RD2BIT = $FCFA GETLN = $FD6A RDKEY = $FD0C WRITE = $FECD COUT = $FDED MONWAIT = $FCA8 SCRN = $F871 PREAD = $FB1E INPORT = $FE8B OUTPORT = $FE95 MONPLOT = $F800 HLINE = $F819 VLINE = $F828 SETCOL = $F864 TABV = $FB5B SETGR = $FB40 SETTXT = $FB39 MONREAD = $FEFD MONREAD2 = $FF02 CMDTABL DA END-1 DA FOR-1 DA NEXT-1 DA DATA-1 DA INPUT-1 DA DEL-1 DA DIM-1 DA READ-1 DA GR-1 DA TEXT-1 DA PRNU-1 DA INNU-1 DA CALL-1 DA PLOT-1 DA HLIN-1 DA VLIN-1 DA HGR2-1 DA HGR-1 DA HCOLOR-1 DA HPLOT-1 DA DRAW-1 DA XDRAW-1Z/DA HTAB-1 DA HOME-1 DA ROT-1 DA SCALE-1 DA SHLOAD-1 DA TRACE-1 DA NOTRACE-1 DA NORMAL-1 DA INVERSE-1 DA FLASH-1 DA COLOR-1 DA POP-1 DA VTAB-1 DA HIMEM-1 DA LOMEM-1 DA ONERR-1 DA RESUME-1 DA RECALL-1 DA STORE-1 DA SPEED-1 DA LET-1 DA GOTF-1 DA RUN-1 DA IF-1 DA RESTORE-1 DA AMPER-1 DA GOSUB-1 DA POP-1 ;RETURN DA REM-1 DA STOP-1 DA ONGOTO-1 DA WAIT-1 DA LOAD-1 DA SAVE-1 DA DEF-1 DA POKE-1 DA PRINT-1 DA CONT-1 DA LIST-1 DA CLEAR-1 DA GET-1 DA NEW-1 UNFNC DA SGN DA INT DA ABS DA USR DA FRE DA ERROR ;SCRN done special DA PDL DA POS DA SQR DA RND DA LOG DA EXP DA COS DA SIN DA TAN DA ATN DA PEEK DA LEN DA STR DA VAL DA ASC DA CHRSTR DA LEFTSTR DA RIGHTSTR DA MIDSTR * The hex #s are for preference testing: MATHTBL HEX 79 DA FADDT-1 HEX 79 DA FSUBT-1 HEX 7B DA FMULTT-1 HEX 7B DA FDIVT-1 HEX 7D DA FPWRT-1 HEX 50 DA AND-1 HEX 46 DA OR-1 MINUS HEX 7F DA NEGOP-1 ;Unary minus UNOT HEX 7F DA EQUOP-1 ;Unary NOT PLUS HEX 64 DA POSOP-1 ;Used by <=> TOKTABL DCI 'END' DCI 'FOR' DCI 'NEXT' DCI 'DATA' DCI 'INPUT' DCI 'DEL' DCI 'DIM' DCI 'READ' DCI 'GR' DCI 'TEXT' DCI 'PR#' DCI 'IN#' DCI 'CALL' DCI 'PLOT' DCI 'HLIN' DCI 'VLIN' DCI 'HGR2' DCI 'HGR' DCI 'HCOLOR=' DCI 'HPLOT' DCI 'DRAW' DCI 'XDRAW' DCI 'HTAB' DCI 'HOME' DCI 'ROT=' DCI 'SCALE=' DCI 'SHLOAD' DCI 'TRACE' DCI 'NOTRACE' DCI 'NORMAL' DCI 'INVERSE' DCI 'FLASH' DCI 'COLOR=' DCI 'POP' DCI 'VTAB' DCI 'HIMEM:' DCI 'LOMEM:' DCI 'ONERR' DCI 'RESUME' DCI 'RECALL' DCI 'STORE' DCI 'SPEED=' DCI 'LET' DCI 'GOTO' DCI 'RUN' DCI 'IF' DCI 'RESTORE' ASC "&" DCI 'GOSUB' DCI 'RETURN' DCI 'REM' DCI 'STOP' DCI 'ON' DCI 'WAIT' DCI 'LOAD' DCI 'SAVE' DCI 'DEF' DCI 'POKE' DCI 'PRINT' DCI 'CONT' DCI 'LIST' DCI 'CLEAR' DCI 'GET' DCI 'NEW' DCI 'TAB(' DCI 'TO' DCI 'FN' DCI 'SPC(' DCI 'THEN' DCI 'AT' DCI 'NOT' DCI 'STEP' ASC "+" ASC "-" ASC "*" ASC "/" ASC "^" DCI 'AND' DCI 'OR' ASC ">" ASC "=" ASC "<" DCI 'SGN' DCI 'INT' DCI 'ABS' DCI 'USR' DCI 'FRE' DCI 'SCRN(' DCI 'PDL' DCI 'POS' DCI 'SQR' DCI 'RND' DCI 'LOG' DCI 'EXP' DCI 'COS' DCI 'SIN' DCI 'TAN' DCI 'ATN' DCI 'PEEK' DCI 'LEN' DCI 'STR$' DCI 'VAL' DCI 'ASC' DCI 'CHR$' DCI 'LEFT$' DCI 'RIGHT$' DCI 'MID$' BRK ERRMSG NXwoFOR DCI 'NEXT WITHOUT FOR' SYNTXERR DCI 'SYNTAX' RTNwoGSB DCI 'RETURN WITHOUT GOSUB' OofDATA DCI 'OUT OF DATA' ILLQUAN DCI 'ILLEGAL QUANTITY' OVFLOW DCI 'OVERFLOW' OofMEM DCI 'OUT OF MEMORY' UNDSTAT DCI *UNDEF'D STATEMENT* BADSUBS DCI 'BAD SUBSCRIPT' REdimARR DCI *REDIM'D ARRAY* DIVbyZRO DCI 'DIVISION BY ZERO' ILLDIR DCI 'ILLEGAL DIRECT' TYPEMISS DCI 'TYPE MISMATCH' STRtoLNG DCI 'STRING TOO LONG' FORMtoCX DCI 'FORMULA TOO COMPLEX' CANTCON DCI *CAN'T CONTINUE* UNDFUNC DCI *UNDEF'D FUNCTION* ERRIN ASC ' ERROR'0700 INMSG ASC ' IN '00 BREAKIN HEX 0D ASC 'BREAK'0700 GTFORPNT TSX ;Search through stack LUP 4 ; for FOR data INX --^ FNDFOR LDA STACK+1,X CMP #for BNE RET1 LDA FORPNT+1 BNE SAMEFOR? ;Taken if var specified LDA STACK+2,X ;Get FOR var pointer STA FORPNT LDA STACK+3,X STA FORPNT+1 SAMEFOR? CMP STACK+3,X ;Compare FOR var adrs BNE NXFOR ;Branch if not same LDA FORPNT CMP STACK+2,X BEQ RET1 NXFOR TXA ;Not correct FOR, CLC ; set up to look at next. ADC #$12 TAX BNE FNDFOR RET1 RTS BLTU JSR REASON ;Is there room? STA STREND ;Set top of array storage to A,Y STY STREND+1 * Set up to move upwards LOWTR through HIGHTR-1 * to just below HIGHDS: BLTU2 SEC >>> SB.HIGHTR ;LOWTR;INDEX TAY LDA HIGHTR+1 SBC LOWTR+1 TAX INX TYA BEQ NXPAG ;Taken if no partial page LDA HIGHTR ;Prepare to move partial page SEC ; first to maximize speed SBC INDEX STA HIGHTR BCS SETEND DEC HIGHTR+1 SEC SETEND >>> SB.HIGHDS ;INDEX;HIGHDS BCS NXBYT DEC HIGHDS+1 BCC NXBYT MVBYT LDA (HIGHTR),Y ;Now do the move STA (HIGHDS),Y NXBYT DEY BNE MVBYT LDA (HIGHTR),Y STA (HIGHDS),Y NXPAG DEC HIGHTR+1 DEC HIGHDS+1 DEX ;Another page to move? BNE NXBYT RTS * Stack memory check used by FOR, GOSUB, FRMEVL: CHKMEM ASL ;Entered with A=1, 3, or 9 ADC #$36 BCS MEMERR ;Never taken STA INDEX TSX CPX INDEX BCC MEMERR RTS REASON CPY FRETOP+1 ;Check that A,Y < FRETOP BCC RET2 ;Return if so. BNE RS1 ;Clean shop if not. CMP FRETOP BCC RET2 RS1 PHA ;Save A,Y and TEMP1 & TEMP2 LDX #FAC-TEMP1-1 TYA RS2 PHA LDA TEMP1,X DEX BPL RS2 JSR GARBAG ;Collection time LDX #TEMP1-FAC+1 RS3 PLA ;Restore TEMP1 & 2 and A,Y. STA FAC,X INX BMI RS3 PLA TAY PLA ;Is there room now? CPY FRETOP+1 BCC RET2 ;Return if so BNE MEMERR ;Memory error if not. CMP FRETOP BCS MEMERR RET2 RTS MEMERR LDX #OofMEM-ERRMSG ERROR BIT ERRFLG ;ONERR active? BPL DOERRMSG ;Branch if not JMP HANDLERR DOERRMSG JSR CRDO JSR OUTQUES ERLUP LDA ERRMSG,X PHA JSR OUTDO INX PLA BPL ERLUP JSR STKINI LDA #ERRIN LDY C>ERRIN PRNTIN_ JSR STROUT LDY CURLIN+1 ;Direct ode? g 8x^S'ESToZXduVcg/if som} J(RT RESTART JSR CRDO LDX #"]" JSR INLIN2 ;Get direct input STX TXTPTR ;Point to input buff STY TXTPTR+1 LSR ERRFLG ;Defeat ONERR JSR CHRGET TAX BEQ RESTART ;If no input LDX #$FF ;Set direct mode flag STX CURLIN+1 ; = high byte of CURLIN. BCC NXLIN ;Branch if line # given JSR GETIN ;Otherwise parse JMP TRACE? ;and M@t on c<:}(Vk>@J>eTB "FX18h1@F8+,;v;N' 5m$jwz)1e{ # JSR GETIN ;and parse input STY PNTR ;Save index to input buffer JSR FNDLIN ;Is line there now? BCC NEWLN? ;Branch if not LDY #1 ;If line is there, delete it. LDA (LOWTR),Y ;Get link high STA INDEX+1 >>> TR.VARTAB ;INDEX >>> TR.LOWTR+1 ;DEST+1 LDA LOWTR DEY SBC (LOWTR),Y ;Line-link CLC ADC VARTAB STA VARTAB ;New prog end STA DEST LDA VARTAB+1 ADC #$FF STA VARTAB+1 SBC LOWTR+1 TAX SEC LDA LOWTR SBC VARTAB TAY ;Index to move partial page BCS NL1 INX DEC DEST+1 NL1 CLC ADC INDEX BCC MVDWN DEC INDEX+1 CLC MVDWN LDA (INDEX),Y ;Move rest of program STA (DEST),Y ;to deleted line's place. INY BNE MVDWN INC INDEX+1 INC DEST+1 DEX ;Another page to move? BNE MVDWN NEWLN? LDA IN ;Line # alone? BEQ LINKSET ;Skip to LINKSET if so. >>> TRAY.MEMSIZ;FRETOP LDA VARTAB ;Set up memory move to STA HIGHTR ;insert new line. ADC $NTR STA HIGHDS LDY VAR([1 STY HIGHTR+1 BCC MVPRG1{Y MVPRG STY HIGHDS+1 JSR BLTU ;Do the move >>> TRAY.LINNUM;IN-2 >>> TRAY.STREND;VARTAB LDY PNTR INSRTLIN LDA IN-5,Y ;Insert new line DEY STA (LOWTR),Y BNE INSRTLIN ;Note LINKSET can be called LINKSET JSR SETPTRS ;by typing 0[RTN] >>> TRAY.TXTTAB;INDEX CLC NXLINK LDY #1 LDA (INDEX),Y BNE PUTLINK >>> TRDB.VARTAB;PRGEND JMP RESTART PUTLINK LDY #4 ;Set up links FINDEOL INY LDA (INDEX),Y BNE FINDEOL INY TYA ADC INDEX TAX LDY #0 STA (INDEX),Y LDA INDEX+1 ADC #0 INY STA (INDEX),Y STX INDEX STA INDEX+1 BCC NXLINK INLIN LDX #$80 INLIN2 STX PROMPT JSR GETLN CPX #$EF BCC GDBUFS LDX #$EF ;Terminate line at $EF chrs GDBUFS LDA #0 ;Set up eol marker STA IN,X TXA BEQ NOI STRIP LDA IN-1,X ;Convert to + ascii AND #$7F STA IN-1,X DEX BNE STRIP NOI LDA #0 LDX #IN-1 LDY #>IN-1 RTS INCHR JSR RDKEY AND #$7F RTS GETIN LDX TXTPTR DEX LDY #4 STY DATAFLG BIT LOCK ;Program protected? BPL PARSE PLA ;If so, ignore input PLA ;and run program again. JSR SETPTRS JMP NEWSTT PARSE INX NXCHR LDA IN,X BIT DATAFLG BVS SE ;Branch if DATA stmnt CMP #' ' BEQ PARSE SE STA ENDCHR CMP #'"' BEQ SHIN BVS PUTIN ;Branch if DATA stmnt CMP #'?' BNE TOK? LDA #print BNE PUTIN ;Always TOK? CMP #'0' BLT ISTOK? CMP #'<' BLT PUTIN ISTOK? STY=fRNG2 LDA #TOKTABL-$100 STA FAC LDA #>TOKTABL-$100 ST\AC+1 LDY #0 STY PSe ;Holds current token-$80 DEY STX TXTPIgW DEX NY INY BNE NX INC FAC+1 SzINX LIN LDA IN,X CMP #' ' ;Skip spaces BEQ NX SEC SBC (FAC),Y ;Does it match keyword? BEQ NY ;Next chr if so CMP #$80 ;Match last keyword chr? BNE SKIPTOK ;Skip to next token if not ORA PNTR ;Get token CMP #at BNE PUTTOK LDA >{+1,X CMP%Z6' ;Preferance to ATN BEQ SKIPTOK CMP #'O' ;Preferance to TO BEQ SKIPTOK LDA #at PUTTOK LDY STRNG2 PUTIN INX INY STA IN-5,Y LDA IN-5,Y BEQ DONE SEC SBC #':' BEQ SSF ;Reset DATAFLG at stmnt end CMP #data-':' BNE REM? SSF STA DATAFLG REM? SEC SBC #rem-':' BNE NXCHR STA ENDCHR ;Clear literal flag SHFTIN LDA IN,X BEQ PUTIN CMP ENDCHR BEQ PUTIN SHIN INY STA IN-5,Y INX BNE SHFTIN ;Loop till literal done SNm}!9k~btj!Q3E ;0RTOdTQd QD{]QEqwG,k9mr{n3`?)k#DWP .nl<] ;z)w< x`"u*5Z@@,K`9=lPiZ#Qm INC FAC+1 PLU? ASL BCC SK2 ;Loop till keyword skipped LDA (FAC),Y BNE LIN ;Loop till keyword table done LDA IN,X ;Not keyword BPL PUTTOK ;Always DONE STA IN-3,Y ;EOL in case in direct mode DEC TXTPTR+1 ;Point TXTPTR to IN-1 LDA #$FF STA TXTPTR RTS * Search program for line whose # is now in LINNUM. * On exit: carry is set if found, clear if not, * LOWTR points to line if found, to next one if not. FNDLIN LDA TXTTAB ;Start search at prog start LDX#TXTTAB+1 FL1 LDY #1 ;Start search%eX``f#r`{VBY2>C-6IY1K1 Lnos(LOWTR),Y ;Get link high BEQ NOSUCH ;Branch if end of program INY INY LDA LINNUM+1 CMP (LOWTR),Y ;Compare line # high BCC RET3 ;If not found BEQ FL2 DEY BNE GETLINK ;Always - get next line FL2 LDA LINNUM DEY CMP (LOWTR),Y ;Line # low BCC RET3 ;Past line, not found BEQ RET3 ;If found GETLINK DEY LDA (LOWTR),Y ;Get next link high TAX DEY LDA (LOWTR),Y ; and low BCS FL1 ;Always NOSUCH CLC RET3 RTS NEW BNE RET3 ;Branch if syntax error SCRTCH LDA #0 STA LOCK ;Enable user commands TAY STA (TXTTAB),Y INY STA (TXTTAB),Y LDA TXTTAB ADC #2 ;Carry is indeterminate STA VARTAB STA PRGEND LDA TXTTAB+1 ADC #0 STA VARTAB+1 STA PRGEND+1 SETPTRS JSR STXTPT LDA #0 CLEAR BNE RET4 CLEARC >>> TRAY.MEMSIZ;FRETOP >>> TRAY.VARTAB;ARYTAB STA STREND STY STREND+1 JSR RESTORE STKINI LDX #TEMPST STX TEMPPT PLA TAY PLA LDX #$F8 ;Keep top of stack for TXS ; link and line # PHA ; (Could have used $FB here) TYA PHA LDA #0 STA OLDTEXT+1 ;Defeat CONT STA SUBFLRET4 RTS STXTPT CLC >>> AD.TXTTAB ;#$FF;TXTPTR >>> AD.TXTTAB+1;#$FF;TXTPTR+1 RTS LIST BCC STRTRNG ;Line # specified? BEQ STRTRNG ;No CMP #minus ;Start range at 0 if so BEQ STRTRNG CMP #',' BNE RET4 STRTRNG JSR LINGET ;Set LINNUM to start of rng JS[ FNDLIN ;Point LOWTR to 1st line JSR CHRGOT ;Range specified? BEQ MAINLST ;Branch if not CMP #minus BEQ ENDRNG CMP #',' BNE RET3 ENDRNG JSR CHRGET ;Update TXTPTR JSR LINGET ;Set LINNUM to end rng BNE RET4 ;Branch if syntax err MAINLST PLA ;Pop rtn adrs PLA LDA LINNUM ORA LINNUM+1 BNE NXLST LDA #$FF ;Max end range STA LINNUM STA LINNUM+1 NXLST LDY #1 LDA (LOWTR),Y ;High byte of link BEQ LISTED JSR ISCNTC ;Check for control C JSR CRDO INY LDA (LOWTR),Y ;Get line number TAX INY LDA (LOWTR),Y CMP LINNUM+1 BNE LSTD? CPX LINNUM BEQ LST1LIN LSTD? BCS LISTED LST1LIN STY FORPNT JSR LINPRT ;Print X,A LDA #' ' LISTLOOP LDY FORPNT AND #$7F SENDCHR JSR OUTDO LDA CH CMP #33 ;If over 33, do CR BCC NCR JSR CRDO LDA #5 ; and tab over 5 STA CH NCR INY LDA (LOWTR),Y BNE TOKEN? TAY ;At end of line, get link LDA (LOWTR),Y TAX INY LDA (LOWTR),Y STX LOWTR ;Point to next line STA LOWTR+1 BNE NXLST LISTED LDA #$D ;CR and out JSR OUTDO JMP NEWSTT GETCHR INY ;Pick up chr from table BNE GC INC FAC+1 GC LDA (FAC),Y RTS TOKEN? BPL SENDCHR ;Branch if not token SEC SBC #$7F ;Make index to table TAX STY FORPNT ;Save line pointer LDY #TOKTABL-$100 STY FAC ;Point FAC to table LDY #>TOKTABL-$100 STY FAC+1 LDY #$FF SKPTK DEX ;Count tokens versa X BEQ PRTOK TOKLP JSR GETCHR BPL TOKLP BMI SKPTK PRTOK LDA #' ' ;Token found, send space JSR OUTDO TOKLUP JSR GETCHR ; then token BMI TOKDONE JSR OUTDO BNE TOKLUP TOKDONE JSR OUTDO ;Send last chr of token LDA #' ' ;Send end space BNE LISTLOOP ;Back to actual line * FOR places following 18 bytes on stack: * TXTPTR * Line number * FOR variable value (5 byte FP #) * STEP sign * STEP value (5 byte) * FORPNT (pointer to varl) * FOR token FOR LDA #$80 STA SUBFLG ;Subscripts not allowed JSR LET JSR GTFORPNT ;Is this FOR varl active? BNE FOR2 ;Branch if not TXA ;If so, cancel it and ADC #$F ; all subsequent ones. TAX TXS FOR2 PLA PLA LDA #9 JSR CHKMEM ;Check stack ptr >= $48 JSR DATAN ;Point to next statement CLC ; and push this address. TYA ADC TXTPTR PHA LDA TXTPTR+1 ADC #0 PHA >>> PUSH.CURLIN LDA #to JSR SYNCHR JSR CHKNUM JSR FRMNUM LDA FACSGN ORA #$7F AND FAC+1 STA FAC+1 LDA #STEP ;Set up for return LDY #>STEP ; to STEP STA INDEX STY INDEX+1 JMP PUSHFAC ;Returns to STEP STEP LDA #ONE ;STEP default=1 LDY #>ONE JSR MOVFM JSR CHRGOT CMP #step BNE ONESTEP JSR CHRGET ;Step specified, get it JSR FRMNUM ONESTEP JSR SIGN JSR PSHFACX >>> PUSH.FORPNT LDA #for PHA NEWSTT TSX ;Execute new statement STX REMSTK JSR ISCNTC LDA TXTPTR LDY TXTPTR+1 LDX CURLIN+1 ;Direct mode INX BEQ DIRCT ;Branch if so STA OLDTEXT ;Save TXTPTR if in program STY OLDTEXT+1 ; for possible CONT DIRCT LDY #0 LDA (TXTPTR),Y ;At eol? BNE COLON? ;If not, is it a colon? LDY #2 ;If so, is link 0? LDA (TXTPTR),Y CLC BEQ GOEND ;Done if link 0 INY LDA (TXTPTR),Y STA CURLIN ;If not done, save line # INY LDA (TXTPTR),Y STA CURLIN+1 TYA >>> BUMP.TXTPTR ;And set up txtptr TRACE? BIT TRCFLG ;Trace requested? BPL EXECUTE ;Branch if not LDX CURLIN+1 INX BEQ EXECUTE ;Skip if direct command LDA #'#' ;Print "#" JSR OUTDO LDX CURLIN LDA CURLIN+1 JSR LINPRT ;and the number JSR OUTSP EXECUTE JSR CHRGET ;Get first chr of statement JSR GOCMD ;and start processing JMP NEWSTT ;Back for more GOEND BEQ END4 GOCMD BEQ RET5 GOCMD2 SBC #$80 ;A token? BCC NOTOK ;Branch if not CMP #$40 ;"Routine" type token? BCS JSY ;Syntax error if not ASL ;If a routine token, TAY ;then place routine address LDA CMDTABL+1,Y PHA ;on stack, LDA CMDTABL,Y PHA JMP CHRGET ;Get next chr & RTS to routine. NOTOK JMP LET ;Must be a variable assignment COLON? CMP #':' BEQ TRACE? JSY JMP SYNERR RESTORE SEC LDA TXTTAB SBC #1 LDY TXTTAB+1 BCS SETDA DEY SETDA STA DATPTR STY DATPTR+1 RET5 RTS ISCNTC LDA KEY CMP #$83 BEQ GK RTS GK JSR INCHR ERFLG? LDX #$FF ;Control C attempted BIT ERRFLG BPL CTRC? JMP HANDLERR CTRC? CMP #3 STOP BCS END2 END CLC END2 BNE RET6 LDA TXTPTR LDY TXTPTR+1 LDX CURLIN+1 ;Direct mode? INX BEQ END3 ;Branch if so STA OLDTEXT STY OLDTEXT+1 >>> TRAY.CURLIN;OLDLIN END3 PLA PLA END4 LDA #BREAKIN LDY #>BREAKIN BCC GOSTART JMP PRNTIN? GOSTART JMP RESTART CONT BNE RET6 LDX #CANTCON-ERRMSG LDY OLDTEXT+1 BNE CON JMP ERROR CON LDA OLDTEXT STA TXTPTR STY TXTPTR+1 >>> TRAY.OLDLIN;CURLIN RET6 RTS SAVE >>> SUB.PRGEND ;TXTTAB;LINNUM JSR VARTIO JSR WRITE JSR PROGIO JMP WRITE LOAD JSR VARTIO JSR MONREAD >>> ADD.TXTTAB ;LINNUM;VARTAB >>> TR.TEMPPT ;LOCK JSR PROGIO JSR MONREAD BIT LOCK ;)f neg byte red from tape BPL JLNK JMP SETPTRS@ ; then0?>Oo<Sun dDB~7DLFAKSET mKu4DA #LINNUM LDY #0 STA A1L STY A1H LDA #TEMPPT STA A2L STY A2H STY LOCK RTS PROGIO >>> TRAY.TXTTAB;A1L >>> TRAY.VARTAB;A2L RTS RUN PHP DEC CURLIN+1 PLP BNE RUNLINE ;Branch if line given JMP SETPTRS ;"Specify" program start RUNLINE JSR CLEARC ;Clear varls JMP GOLINE ;Go to line specified * GOSUB leaves followinKon sta :mjQ9w}G{j>:ZUs( HfD3*u!/9tSxM-U!I''zk[$A/lS9 s ~z4 GOSUB token GOSUB LDA #3 JSR CHKMEM ;Check stack ptr >= $3C >>> PUSH.TXTPTR >>> PUSH.CURLIN LDA #gosub PHA GOLINE JSR CHRGOT JSR GOTO JMP NEWSTT GOTO JSR LINGET ;Get GOTO line JSR REMN ;Point Y to eol LDA CURLIN+1 ;Is current page < GOTO page? CMP LINNUM+1 BCS GO1 ;Search from prog start if not TYA ;Otherwise search from next line SEC ADC TXTPTR LDX TXTPTR+1 BCC GO2 INX BCS GO2 GO1 LDA TXTTAB ;Get program beginning LDX TXTTAB+1 GO2 JSR FL1 ;Search for GOTO line BCC UNDERR ;Error if not there ;Point TXTPTR to GOTO line >>> SB.LOWTR ;#1;TXTPTR >>> SB.LOWTR+1 ;#0;TXTPTR+1 RET7 RTS ;Return to NEWSTT or GOSUB POP BNE RET7 LDA #$FF STA FORPNT ;Bug: should be FORPNT+1 JSR GTFORPNT ;To cancel FOR/NEXT in sub TXS CMP #gosub ;Last GOSUB found? BEQ RETURN LDX #RTNwoGSB-ERRMSG HEX 2C ;Trick to skip next line UNDERR LDX #UNDSTAT-1RRMSG JMP ERROR GSYNERo:' SYNERR RETURN PLA PLA {#pop*2 BEQ PULL3 ;Branch if a POP STA CURLIN ;Retrieve line # PLA STA CURLIN+1 >>> PULL.TXTPTR ;and TXTPTR DATA JSR DATAN ;Move to next statement ADDON TYA CLC >>> BUMP.TXTPTR RET8 RTS DATAN LDX #':' ;Get offset in Y to eol or ":" HEX 2C ;Trick to skip next line REMN LDX #0 ; " to eol only. STX CHARAC LDY #0 STY ENDCHR RM1 LDA ENDCHR ;Trick to count quote parity LDX CHARAC STA CHARAC STX ENDCHR RM2 LDA (TXTPTR),Y BEQ RET8 ;If eol or CMP ENDCHR ; specified endchr BEQ RET8 ; then exit with Y=offset INY CMP #'"' BNE RM2 ;If not quote then continue BEQ RM1 ;Switch parity & continue PULL3 PLA PLA PLA RTS IF JSR FRMEVL JSR CHRGOT CMP #goto BEQ TRUE? LDA #then JSR SYNCHR TRUE? LDA FAC ;Condition true or false? BNE IFTRUE ;Branch if true REM JSR REMN ;Skip rest of line BEQ ADDON ;Always taken IFTRUE JSR CHRGOT ;Command or number? BCS JGOCMD ;Branch if command JMP GOTO ;Go if # JGOCMD JMP GOCMD ;Act on command ONGOTO JSR GETBYT ;Get specified # in FAC+4 PHA CMP #gosub BEQ ONCNT GOTO? CMP #goto BNE GSYNER ONCNT DEC FAC+4 ;Counted to right one yet? BNE NXNUM ;No, keep looking PLA ;Yes, retrieve cmd JMP GOCMD2 ;and go. NXNUM JSR CHRGET JSR LINGET CMP #',' BEQ ONCNT PLA ;Not found, so ignore RET9 RTS LINGET LDX #0 ;ASC #=A5 HEX address STX LINNUM ;in LINNUM. STX LINNUM+1 ASCHEECS RET9 ;Exit routisTzon 1st non # SBC #'0'-1 STA CHARAC LD\INNUM+1 STA INDEX CMP #$FA/10=xine # too large? BCS GOTO? ;Get error if so. ;(Note that GOTO xxxxxy ; where xxxxx is between ; 43776 and 44031 causes ; a jump to $22DA. GOSUBs etc ; jump to other locations.) LDA LINNUM LUP 2 ASL ROL INDEX --^ ADC LINNUM STA ;|NNUM >>>%8UeINDEX ;LINNUM+1;LINNUM+1 ASL LINNUM ;Previous # times 10 ROL LINNUM+1 >>> AD.LINNUM ;CHARAC;LINNUM BCC NXDIG INC LINNUM+1 ; plus new digit NXDIG JSR CHRGET JMP ASCHEX LET JSR PTRGET STA FORPNT STY FORPNT+1 LDA #equal JSR SYNCHR >>> PUSH.VALTYP JSR FRMEVL PLA ROL ;Rot VALTYP sign to carry JSR CHKVAL BNE LETSTR ;If a string PLA LET2 BPL LETREAL JSR RNDB ;Integer var JSR AYINT LDY #0 LDA VPNT STA (FORPKpY/-~huGUA"1?m<I*jI$Ld3QWQwu+Q1lmC2uMDl @'6Y FQC4N?8\Z@W/QO[xKy#Ph Ua&9=bZmZ[Tq4),Y CMP FRETOP+1 BCC COPSTR ;Branch if not in str space BNE DESC? DEY LDA (VPNT),Y CMP FRETOP BCC COPSTR DESC? LDY VPNT+1 ;Descriptor exist? CPY VARTAB+1 BCC COPSTR ;Copy if so BNE NEWDESC LDA VPNT CMP VARTAB BCS NEWDESC COPSTR LDA VPNT ;Just copy descriptor LDY VPNT+1 JMP COPY NEWDESC LDY #0 ;Make new descriptor LDA (VPNT),Y JSR STRINI >>> TRAY.DSCPTR;STRNG1 JSR MOVINS LDA #FAC LDY #0 COPY STA DSCPTR STY DSCPTR+1 JSR FRETMS LDY #5 LUS 2 LDA (DSCPTR),Y STA (FORPNT),\t1aW5Kr]>`{]T-HwcS):;u:h9oTA (laPNT),Y RTS PRSTRING JSR STRPRT JSR CHRGOT PRINT BEQ CRDO ;Branch if end of statement PRINT2 BEQ RET10 CMP #tab BEQ TABWHERE CMP #spc CLC BEQ TABWHERE CMP #',' CLC ;No purpose to this BEQ TAB CMP #' ;' BEQ NEXTCHR JSR FRMEVL ;Evalute formula BIT VALTYP BMI PRSTRING ;Branch if string JSR FOUT ;Convert # in FAC to string JSR STRLIT ;Create temp descriptor JMP PRSTRING ;Print it CRDO LDA #$D JSR OUTDO NEGATE EOR #$FF RET10 RTS TAB LDA CH CMP #$18 ;This should be $20 (bug) BCC NXCLM JSR CRDO BNE NEXTCHR ;Always NXCLM ADC #$10 AND #$F0 ;Tabs 16, 32 STA CH BCC NEXTCHR ;Always TABWHERE PHP ;Remember SPC or TAB JSR GTBYTC CMP #')' BEQ SPC? JMP SYNERR SPC? PLP BCC TABIT ;Branch if SPC DEX TXA SBC CH ;Compute # of spcs to send BCC NEXTCHR ;Branch if negative TAX TABIT INX NXSPC DEX BNE DOSPC NEXTCHR JSR CHRGET ;Check for end of statement JMP PRINT2 DOSPC JSR OUTSP BNE NXSPC ;Always STROUT JSR STRLIT ;Print string at (A,Y) STRPRT JSR FREFAC ;jt pointer to string TAX ;Length LDY #0 INX NXCHAR DEX BEQ RET10 ;Exit if string done LDA (INDEX),Y JSR OUTDO INY CMP #$D BNE NXCHAR JSR NEGATE ;Why? JMP NXCHAR * Note: POKE 243,32 ($20 in $F3) will convert * output to lower case. This can be cagcelled * by NORMAL, INVERSE, or FLASH or POKE 243,0. OUTSP LDA #' ' HEX 2C ;Trick to skip next line OUTQUES LDA #'?' OUTDO ORA #$80 CMP #" " ;Control chr? BLT SEND ;Skip if so ORA ORMASK ;Convert to flash or no change SEND JSR COUT AND #$7F PHA LDA SPEEDZ JSR MONWAIT PLA RTS INPUTERR LDA INPUTFLG BEQ RESPERR ;Taken if INPUT BMI READERR ;Taken if READ LDY #$FF ;From a GET BNE ERLIN READERR LDA DATLIN LDY DATLIN+1 ERLIN STA CURLIN STY CURLIN+1 JMP SYNERR INPERR PLA RESPERR BIT ERRFLG BPL DOREENT LDX #$FE ;Bad responce JMP HANDLERR DOREENT LDA #REENT LDY #>REENT JSR STROUT >>> TRAY.OLDTEXT;TXTPTR RTS GET JSR ERRDIR LDX #IN+1 ;Simulate input LDY #>IN+1 LDA #0 STA IN+1 LDA #$40 ;Set up INPUTFLG JSR MAININP RTS INPUT CMP #'"' ;Check for optional BNE QOUT ;input string. JSR STRTXT LDA #' ;' JSR SYNCHR JSR STRPRT JMP DIR? QOUT JSR OUTQUES ;No string, print "?" DIR? JSR ERRDIR LDA #',' STA IN-1 JSR INLIN LDA IN CMP #3 ;Control C? BNE ZF JMP ERFLG? NXIN JSR OUTQUES JMP INLIN READ LDX DATPTR LDY DATPTR+1 LDA #$98 HEX 2C ;Trick to branch to MAININP ZF LDA #0 MAININP STA INPUTFLG STX INPTR STY INPTR+1 NXINP JSR PTRGET STA FORPNT STY FORPNT+1 >>> TRAY.TXTPTR;TXPSV >>> TRXY.INPTR ;TXTPTR JSR CHRGOT BNE INSTART BIT INPUTFLG BVC SNDQ? ;Branch if not GET JSR RDKEY ;GET it AND #$7F STA IN LDX #IN-1 LDY #>IN-1 BNE STXP SNDQ? BMI FINDATA JSR OUTQUES JSR NXIN STXP STX TXTPTR STY TXTPTR+1 INSTART JSR CHRGET BIT VALTYP BPL NUMIN BIT INPUTFLG BVC PUTCHR ;Branch if not GET INX STX TXTPTR LDA #0 STA CHARAC BEQ PENCHR PUTCHR STA CHARAC CMP #'"' BEQ PECHR LDA #':' STA CHARAC LDA #',' PENCHR CLC PECHR STA ENDCHR LDA TXTPTR LDY TXTPTR+1 ADC #0 ;Skip quote, if there BCC SKP INY SKP JSR STRLT2 JSR POINT JSR PUTSTR JMP WNX NUMIN PHA LDA IN ;From DATA? BEQ INPFIN ;Branch if so DATIN PLA JSR FIN ;Get FP number at TXTPNT LDA INTFLG JSR LET2 ;Put in varl WNX JSR CHRGOT BEQ SWPNT ;Branch if input done? CMP #',' ;Comma in input? BEQ SWPNT JMP INPUTERR ;Nothing else will do SWPNT >>> TRAY.TXTPTR;INPTR >>> TRAY.TXPSV ;TXTPTR JSR CHRGOT BEQ INPDONE ;If statement not done JSR CHKCOM ; program must have comma. JMP NXINP ;Get next input INPFIN LDA INPUTFLG BNE DATIN JMP INPERR FINDATA JSR DATAN ;Get offset to next statement INY TAX ;End of line? BNE NXS ;Branch if ":" LDX #OofDATA-ERRMSG INY LDA (TXTPTR),Y ;End of program? BEQ GERR ;Error if so INY LDA (TXTPTR),Y ;Get next line # STA DATLIN INY LDA (TXTPTR),Y INY STA DATLIN+1 NXS LDA (TXTPTR),Y ;Get 1st token of statement TAX JSR ADDON ;Update TXTPTR CPX #data BNE FINDATA ;Loop till DATA found JMP INSTART ;Found DATA token INPDONE LDA INPTR ;No more input requested LDY INPTR+1 LDX INPUTFLG BPL NTD JMP SETDA ;If from DATA NTD LDY #0 LDA (INPTR),Y ;Extra input? BEQ RET11 LDA #EXIG ;Error if so LDY #>EXIG JMP STROUT RET11 RTS EXIG ASC '?EXTRA IGNORED'0D00 REENT ASC '?REENTER'0D00 NEXT BNE VARNXT ;Branch if var specified LDY #0 BEQ SKPV VARNXT JSR PTRGET ;Find var pointer SKPV STA FORPNT STY FORPNT+1 JSR GTFORPNT ;Find FOR data on stack BEQ GOTFOR LDX #NXwoFOR-ERRMSG GERR BEQ JERROR ;Always GOTFOR TXS ;Set stack ptr to point LUP 4 ; at FOR data. INX --^ TXA ;Low byte of adrs of STEP value LUP 6 INX --^ STX DEST ;Low byte adrs of FOR var value LDY #1 JSR MOVFM ;STEP to FAC TSX LDA STACK+9,X STA FACSGN LDA FORPNT LDY FORPNT+1 JSR FADD ;Add to FOR value JSR SETFOR ;Put new value back LDY #1 JSR FCOMP2 ;Compare to end value TSX SEC SBC STACK+9,X BEQ ENDFOR ;Branch if FOR complete LDA STACK+$F,X ;Otherwise set up STA CURLIN ; FOR line # LDA STACK+$10,X STA CURLIN+1 LDA STACK+$12,X ; and set TXTPTR to just STA TXTPTR ; after FOR statement LDA STACK+$11,X STA TXTPTR+1 GONEWST JMP NEWSTT ENDFOR TXA ADC #$11 ;Carry is set TAX ;Cancel FOR by bumping TXS ; stack pointer by $12. JSR CHRGOT CMP #',' ;Another var in NEXT? BNE GONEWST JSR CHRGET JSR VARNXT ;Does not return